#! /usr/local/bin/perl
##
##	canned_reply - send an automatic reply to mail
##
##	Usage (in /etc/aliases):
##		owner-alias: bounceaddr
##		alias: "|progpath alias replypath bounceaddr"
##	or
##		alias: "|progpath alias replypath bounceaddr", /archive
##	where:
##
##	- progpath = full pathname of this script
##
##	- alias = name of alias @ actual host,
##		like: book-info-request@online.ora.com
##
##	- replypath = pathname of file we send as the canned reply.
##		If no leading /, reads file from $replies directory (defined below).
##		File should start with NO BLANK LINE, then From:, Subject:
##		and any other header except To: (which this program fills in).
##		Then, before message in file, put a single blank line.
##
##	- bounceaddr = address (envelope sender) to send bounces to
##
##	- /archive = full pathname of archive file to save all incoming messages
##		(usually needs to be mode 666 unless no messages come from local host)
##
##		by Jerry Peek, 8/17/93


# TABSTOPS IN THIS SCRIPT SET AT 4 (IN vi, USE :se ts=4 sw=4)

# Modify $replies and $mailer for your system if necessary:
$replies = "/usr/local/lib/canned_replies";	# Default directory for reply files
$mailer = "/usr/lib/sendmail -f$ARGV[2] -oi";
$* = 1;

#
# Tack path onto reply file if it doesn't start with a slash:
#
$replypath = (($ARGV[1] =~ m@^/@) ? "" : "$replies/") . $ARGV[1];

#
# If wrong number of args or unreadable canned reply file,
# send error and sender's mail message to postmaster:
#
if (scalar(@ARGV) != 3) {
	$complaint = "need 3 arguments, got:\n\t@ARGV";
}
elsif (! -r $replypath) {
	$complaint = "can't read reply file '$replypath'.";
}
if ($complaint) {
	open(MAIL, "|$mailer postmaster") || die;
	print MAIL "$0 aborting from '$ARGV[0]' alias:\n\t$complaint\n\n";
	# End string with > to prefix the From line in the message:
	print MAIL "This message needs a reply:\n\n>";
	print MAIL <STDIN>;
	close(MAIL);
	exit(0);	# We don't want sender to know that something went wrong
}

#
# Read (only) header into the variables $from (for envelope sender)
# and $header (for the rest of the header)
#
while (<STDIN>) {
	last if /^$/;
	# Make key lower-case:
	if (/^From /) {
		# listproc system is case-sensitive on first line;
		# if it's "from" instead of "From", it's a syntax error.
		# So, save From line separately.
		@from = (split(/^([-\w]+)[ 	]*/));
	}
	elsif (/^\S/) {
		@part = (split(/^([-\w]+:?)[ 	]*/));
		$part[1] =~ tr/A-Z/a-z/;
		$header .= "$part[1] $part[2]";
	}
	else {
		$header .= $_;
	}
}

#
# Put headers into array.  Note: values (but not keys) end with newlines.
# (Adapted from "Programming Perl" chapter 4.)
# Note: loses multiple lines with same key (like Received:):
#
$header =~ s/\n\s+/ /g;      # Merge continuation lines.
%head = ('FRONTSTUFF', split(/^([-\w]+:?)[ 	]*/, $header));

# Now we can read body from <STDIN> if we need to...

#
# Get address to use:
#
if (defined($head{'reply-to:'})) {
	$useaddr = $head{'reply-to:'};
}
elsif (defined($head{'from:'})) {
	$useaddr = $head{'from:'};
}
elsif (defined($head{'apparently-from:'})) {
	$useaddr = $head{'apparently-from:'};
}

#
# If we got an address, use it.  Else, bounce to bounceaddr:
#
if (defined($useaddr)) {
	chop $useaddr;
	open(REPLY, $replypath) || die;
	open(MAIL, "|$mailer -t") || die;
	print MAIL "To: $useaddr\n";
	# REPLY file may start with From:, Subject:; MUST then have blank line:
	print MAIL <REPLY>;
	print MAIL "\n\n ----------- Your original message is below ----------\n\n";
	print MAIL <STDIN>;
	close(MAIL);
	close(REPLY);
}
else {
	# BOUNCE TO bounceaddr
	open(MAIL, "|$mailer $ARGV[2]") || die;
	print MAIL "$0 aborting: can't find address to reply to.\n\n";
	# End string with > to prefix the From line in the message:
	print MAIL "This message needs a reply:\n\n>";
	print MAIL <STDIN>;
	close(MAIL);
}
exit(0);	# We don't want sender to know that something went wrong
